COMMENT ⊗   VALID 00005 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 Chart Making program for TEX output.
C00005 00003	 The lines of a box are segments. So a Box would look like:
C00009 00004	 Impl cpu gc cpu+gc real page
C00013 00005	(defun setup-timrep-files ()
C00023 ENDMK
C⊗;
;;; Chart Making program for TEX output.
;;; This is for making charts of exactly what each implementation
;;; has reported in each benchmark
;;;	(...(benchmark 
;;;	     (impl1 entry1) (impl2 entry2)...) ...)
;;;
;;; For each benchmark:
;;;(...(benchmark
;;;     ((blankline))
;;;     ((indent 1) "Benchmark 3" (entry (f entry)))
;;;     ((center) "Random Text"))...)
;;;
;;; For each implementation:
;;;(...(impl "Top-row Information")...)


(declare (special *data* *benchmarks* *all-implementations* *leave-outs*
		  *max-significand-digits*
		  *all-implementations-short* *subset-relationships*
		  *all-benchmarks*))
(sstatus syntax #o45 (status syntax #o40))

(eval-when (load eval) (setq *max-significand-digits* 4))

(declare (special *benchmark-info*))

(setq *leave-outs* '(ti-exp lcl-sun))

(defun get-bench-data (bench)
       (cdr (assoc bench *data*)))

(defun get-bench-entry (impl full-entry)
       (cadr (assoc impl full-entry)))

(defmacro trunc (x)
	  `(//$ 
	    (float 
	     (fix 
	      (times 100.0 ,x))) 100.0))

(defun tsafe-quotient (x y)
       (cond ((and (numberp x)
		   (numberp y))
	      (cond ((and (zerop x)(zerop y))
		     1.0)
		    ((zerop y) '"$\infty$")
		    (t (round (quotient x y)))))))

(defun filter-out (l leave-outs)
       (mapcan #'(lambda (x)
			 (cond ((memq (car x)
				      leave-outs)
				())
			       (t (ncons x))))
	       l))

(defmacro do-chunks (n l . forms)
	  (let ((varn (gensym))
		(varvar (gensym)))
	       `(let ((,varn ,n)
		      (,varvar ()))
		     (cond ((numberp ,varn)
			    (do ((lll ,l))
				((null lll))
				(setq ,varvar ())
				(do ((n ,varn (1- n)))
				    ((or (< n 1)
					 (null lll))
				     (let ((,l (nreverse ,varvar)))
						  ,@forms))
				    (push (car lll) ,varvar)
				    (setq lll (cdr lll)))))
			   (t ,@forms)))))

;;; The lines of a box are segments. So a Box would look like:
;;;	<blankline>
;;;	Division by 2
;;;	<blankline>
;;;	   Recursive
;;;	   Iterative
;;;	<blankline>

(declare (mapex t))

(defun make-a-chart (full-benchmark entry-fun file)
       (princ "&&\hfil {\bf Implementation}\hfil&&" file)
       (princ "{\bf CPU}&&{\bf GC}&&{\bf Real}&&{\bf Paging}&\cr\tablerule" file)
       (make-rows full-benchmark
		  entry-fun file)
       t)

(defun make-rows (full-benchmark entry-fun file)
 (let  ((info
	 (get-bench-data full-benchmark)))
       (let ((data
	      (mapcar 
	       #'(lambda (impl)
			 (mapcar
			  #'(lambda (entry)
				    (cons (car entry)
					  (let ((stuff
						 (funcall entry-fun 
							  (get-bench-entry
							   (car impl)
							   info))))
					       (mapcar 
						#'(lambda (fun)
							  (and fun stuff
							       (funcall 
								fun stuff)))
						(cadr entry)))))
			  (cadr impl)))
	       (filter-out *all-implementations-short* *leave-outs*))))
	    (do ((data data (cdr data)))
		((null data) t)
		(do ((impl-entry (car data) (cdr impl-entry)))
		    ((null impl-entry))
		    (terpri file)
		    (princ "&&" file)
		    (princ (caar impl-entry) file)
		    (cond ((null (cdar impl-entry))
			   (princ "&&&&&&&&&\cr" file)
;			   (terpri file)
			   )
			  (t (do ((line (cdar impl-entry) (cdr line)))
				 ((null line) 
				  (cond ((not (null (cdr impl-entry)))
					 (princ "&\cr" file))
					(t (princ "&\cr\tablerule" file)))
;				  (terpri file)
				  )
				 (princ "&&" file)
				 (cond ((null (car line)))
				       (t 
					(princ-two-decimals-and-pad
					 (trunc (car line)) 
					 *max-significand-digits* file)))))))))))

(defun princ-two-decimals-and-pad (f n file)
       (let ((f10 (fix (*$ (float f) 100.0)))
	     (f10a (* (fix f) 100.)))
	    (princ-pad (fix f) n file)(princ "." file)
	    (let ((rest (- f10 f10a)))
		 (cond ((zerop rest)
			(princ "00" file))
		       ((< rest 10.)
			(princ "0" file)(princ rest file))
		       (t (princ rest file)))
		 (princ "??" file))))

(defun princ-pad (fx n file)
       (do ((i (- n (flatsize fx)) (1- i)))
	   ((zerop i) (princ fx file))
	   (princ "?" file)))

;;; Impl cpu gc cpu+gc real page

;;; (do-fchart 'tak)
;;; (do-fchart 'traverse)
;;; (do-fchart 'traverse-init)
;;; Look at *all-benchmarks* in DATA.BCH[TIM,LSP] to see the options.

(defun do-fchart (benchmark &optional (filename t) (bigstrutp t)
			    (maxentries ()))
       (let ((entry (cdr (assq benchmark *subset-relationships*)))
	     (file (cond ((eq filename 't) t)
			 (t (open filename '(out ascii))))))
	    (unwind-protect
	     (progn 
	      (cond (bigstrutp
		     (terpri file)
		     (princ "\newbox\bigstrutbox" file)
		     (terpri file)
		     (princ "\setbox\bigstrutbox=\hbox{\vrule height8.6pt depth3.6pt width0pt}" file)
		     (terpri file)
		     (princ "\def\bigstrut{\relax\ifmmode\copy\bigstrutbox\else\unhcopy\bigstrutbox\fi}" file)
		     (terpri file)))
	      (do-chunks maxentries *all-implementations-short*
			 (cond (entry
				(mapc #'(lambda (x) (do-fchart1 benchmark x file)
						(terpri file)
						(princ "\vfill\eject" file)
						(terpri file)
						)(car entry)))
			       (t (do-fchart1 benchmark benchmark file)))))
	     (cond ((not (eq filename 't))
		    (close file))))
	    t))

(defun do-fchart1 (full-benchmark benchmark file)
       (let ((n 4)(entry (cdr (assq benchmark *all-benchmarks*))))
	    (princ "$$\vbox{\tabskip=0pt \offinterlineskip" file)
	    (terpri file)
	    (princ "\catcode`?=\active" file)
	    (terpri file)
	    (princ "\def?{\kern\digitwidth}" file)
	    (terpri file)
	    (princ "\def\tablerule{\noalign{\hrule}}" file)
	    (terpri file)
	    (princ "\halign {\bigstrut#& \vrule#\tabskip=1em plus2em&#& \vrule#&" file)
	    (do ((i (1- n) (1- i)))
		((zerop i)
		 (princ "\hfil#\hfil& \vrule#\tabskip=0pt\cr\tablerule" file)
		 (terpri file)
		 (princ "&&\multispan{" file)(princ (1+ (* n 2)) file)
		 (princ "}\hfil {\bf Raw Time}\hfil&\cr" file)
		 (terpri file)
		 (princ "&&\multispan{" file)(princ (1+ (* n 2)) file)
		 (princ "}{\hfil {\bf " file)(princ (car entry) file)
		 (princ "}}\hfil&\cr\tablerule" file)
		 (terpri file)
		 )
		(princ "\hfil#\hfil& \vrule#&" file)(terpri file))
       (make-a-chart
	full-benchmark
	(cadr entry) file)
       (princ "}}$$" file)))
(defun setup-timrep-files ()
       (let ((l
	      '(boyer browse destru traverse tak stak ctak takl takr deriv dderiv fdderiv
		      div2 fft puzzle triang fprint fread tprint frpoly))
             (files
	      '("boyer.tex"
		"browse.tex" 
		"destru.tex"
		"traverse.tex"
		"tak.tex"
		"stak.tex"
		"ctak.tex"
		"takl.tex"
		"takr.tex"
		"deriv.tex"
		"dderiv.tex"
		"fdderiv.tex"
		"div2.tex"
		"fft.tex"
		"puzzle.tex"
		"triang.tex"
		"fprint.tex"
		"fread.tex"
		"tprint.tex"
		"frpoly.tex")))
	    (do ((l l (cdr l))
		 (files files (cdr files)))
		((null l))
		(do-fchart (car l)(car files) () 30.))))